home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / BARNET / COMPILER / SATHER / !Sather / Library / Graphs / sa / lbld_digr < prev    next >
Text File  |  1996-08-30  |  7KB  |  220 lines
  1. ---------------------------> Sather 1.1 source file <--------------------------
  2. -------------------------------------------------------------------
  3. abstract class $LBLD_DIGRAPH{NTP,NLB,ELB} < $DIGRAPH{NTP} is
  4.    -- A digraph with node (NLB) and edge (ELB) labels 
  5.  
  6.    -- Reading routines
  7.    node_label(n: NTP): NLB;
  8.    edge_label(e: DIEDGE{NTP}): ELB;
  9.  
  10.    -- Writing routines
  11.    set_node_label(n: NTP, w: NLB);
  12.    set_edge_label(e: DIEDGE{NTP},w: ELB);
  13.  
  14.    outgoing!(once n: NTP, out a_node_label: NLB, out a_edge_label: ELB): NTP;
  15.    -- Yield the outgoing nodes for "n" and also provide the node and
  16.    -- edge labels at the same time. It might be much more efficient
  17.    -- to yield these together, in order, than to have to look up the node and
  18.    -- edge labels separately.
  19.    
  20.    incoming!(once n: NTP, out a_node_label: NLB, out a_edge_label: ELB): NTP;
  21.    -- Similar to the outgoing iter, but yield all incoming nodes into "n"
  22.       
  23.    connect(src,dest:NTP,w: ELB);
  24.    -- It is still possible to connect nodes without specifying a label
  25.    
  26.    add_node_labelled(w: NLB): NTP;
  27.    -- It is still possible to use the digraph "add_node" function
  28.    -- to  not specify a node label
  29.    
  30.    has_node_label(n: NTP): BOOL;
  31.    -- Return true if the node "n" has a label
  32.  
  33.    has_edge_label(e:DIEDGE{NTP}): BOOL;
  34.    -- Return true if the edge "e" has a label
  35.    
  36.    are_all_nodes_labelled: BOOL;
  37.    -- Returns true if all the nodes have labels
  38.    
  39.    are_all_edges_labelled: BOOL;
  40.    -- Returns true if all edges have labels
  41.    
  42. end;
  43. -------------------------------------------------------------------
  44. partial class LBLD_DIGRAPH_INCL{NTP,NLB,ELB} is
  45.    -- A mixin that associates labels with the nodes/edges of a graph
  46.  
  47.    private attr node_labels: MAP{NTP,NLB};
  48.    private attr edge_labels: MAP{DIEDGE{NTP},ELB};
  49.    
  50.    stub connect(n1,n2: NTP);
  51.    stub add_node(n: NTP);
  52.    stub add_node: NTP;
  53.    stub node!: NTP;
  54.    stub edge!: DIEDGE{NTP};
  55.    stub incoming!(n: NTP): NTP;
  56.    stub outgoing!(n: NTP): NTP;
  57.  
  58.    private init_labels pre ~void(self) is
  59.       -- This routine initializes the label datastructures.
  60.       -- Since this class is meant to be used by inclusion, this
  61.       -- routine should be called after the class has been created
  62.       node_labels := #;
  63.       edge_labels := #;
  64.    end;
  65.    
  66.    has_node_label(n:NTP): BOOL is 
  67.       return node_labels.has_ind(n);
  68.    end;
  69.  
  70.    has_edge_label(e:DIEDGE{NTP}): BOOL is 
  71.       return edge_labels.has_ind(e);
  72.    end;
  73.  
  74.    node_label(n:NTP): NLB is
  75.       -- Return void if the node is not labelled
  76.       if ~node_labels.has_ind(n) then return void
  77.       else return node_labels[n] end;
  78.    end;
  79.    
  80.    edge_label(e:DIEDGE{NTP}): ELB is
  81.       -- Return the edge label if it exists, void otherwise
  82.       if ~edge_labels.has_ind(e) then return void
  83.       else return edge_labels[e] end;
  84.    end;
  85.    
  86.    node!(out label: NLB): NTP is
  87.       -- Yield successive nodes and set the corresponding value of "label"
  88.       -- to the node's label (or void, if it is not labelled)
  89.       loop n ::= node!; label := node_label(n); yield n; end;
  90.    end;
  91.    
  92.    edge!(out label: ELB): DIEDGE{NTP} is
  93.       -- Yield successive edges and set the corresponding value of "label"
  94.       -- to be the edge's label, or void otherwise
  95.       loop e ::= edge!; label := edge_label(e); yield e; end;
  96.    end;
  97.  
  98.    incoming!(once n: NTP, out a_node_label: NLB, out a_edge_label: ELB): NTP is
  99.       -- Yield successive incoming nodes to node "n". Set the out parameter
  100.       -- "a_node_label" to be the corresponding label of the incoming node
  101.       -- and "a_edge_label" to be the label of the corresponding edge from
  102.       -- the incoming node to "n"
  103.       loop 
  104.      inc ::= incoming!(n);
  105.      a_node_label := node_label(inc); 
  106.      a_edge_label := edge_label(#DIEDGE{NTP}(inc,n));
  107.      yield inc;
  108.       end;
  109.    end;
  110.  
  111.    outgoing!(once n: NTP, out a_node_label: NLB, out a_edge_label: ELB): NTP is
  112.       -- See incoming!
  113.       loop 
  114.      outg ::= outgoing!(n);
  115.      a_node_label := node_label(outg); 
  116.      a_edge_label := edge_label(#DIEDGE{NTP}(n,outg));
  117.      yield outg;
  118.       end;
  119.    end;
  120.  
  121.    connect(n1,n2: NTP,w: ELB) is
  122.       -- Add an edge from "n1" to "n2" with the edge label "w"
  123.       connect(n1,n2);
  124.       set_edge_label(#DIEDGE{NTP}(n1,n2),w);
  125.    end;
  126.    
  127.    add_node(n: NTP,w: NLB) is
  128.       -- Add the node "n" to the graph with the node label "w"
  129.       add_node(n);
  130.       set_node_label(n,w);
  131.    end;
  132.  
  133.    add_node_labelled(w: NLB): NTP is
  134.       -- Add the node "n" to the graph with the node label "w"
  135.       n ::= add_node;
  136.       set_node_label(n,w);
  137.       return n;
  138.    end;
  139.  
  140.    add_node(n: NTP,l: NLB): SAME is add_node(n,l); return self end;
  141.       -- Version of "add_node" that returns self for convenience in 
  142.       -- chaining operations
  143.  
  144.    connect(s,d: NTP,l:ELB): SAME is connect(s,d,l); return self end;
  145.       -- Version of "connect" that returns self for convenience in 
  146.       -- chaining connections
  147.       
  148.    set_node_label(n: NTP,w: NLB) is 
  149.       -- Set the label of node "n" to "w"
  150.       node_labels[n] := w; 
  151.    end;
  152.    
  153.    set_edge_label(e: DIEDGE{NTP},w: ELB) is 
  154.       -- Set the label of edge "e" to "w"
  155.       edge_labels[e] := w; 
  156.    end;
  157.    
  158.    are_all_nodes_labelled: BOOL is
  159.       -- Return true if all the nodes in self have a label
  160.       loop n ::= node!;
  161.      if ~node_labels.has_ind(n) then return false end;
  162.       end;
  163.       return true;
  164.    end; 
  165.    
  166.    are_all_edges_labelled: BOOL is
  167.       -- Return true if all the edges in self are labelled
  168.       loop e ::= edge!;
  169.      if ~edge_labels.has_ind(e) then return false end;
  170.       end;
  171.       return true;
  172.    end;
  173.  
  174.    str: STR is
  175.       -- Print out the graph using the bound routine "f"
  176.       -- for the nodes   
  177.       res ::= #FSTR("");
  178.       loop n ::= node!;
  179.      -- if void(n) then res := res + "void  : ";
  180.      -- Should never have "void" nodes in the graph.
  181.      -- If they are value types, then void might be 0 or something useful
  182.      res := res + ob_str(n); 
  183.      if has_node_label(n) then res:=res+"["+ob_str(node_label(n))+"]" end;
  184.      res := res + "<-";
  185.      loop inc ::= incoming!(n);
  186.         inc_edge ::= #DIEDGE{NTP}(inc,n);
  187.         if has_edge_label(inc_edge) then
  188.            inc_lbl ::= edge_label(inc_edge);
  189.            res:=res + ",".separate!(ob_str(inc)+"["+ob_str(inc_lbl)+"]"); 
  190.         else
  191.            res:=res + ",".separate!(ob_str(inc)+"[]"); 
  192.         end;
  193.      end;
  194.      res := res+"\n";        -- End of another row of edges
  195.       end; -- All graph nodes
  196.       return(res.str);
  197.    end;   
  198.    
  199.    private ob_str(n: $OB): STR is
  200.       typecase n
  201.       when $STR then return n.str
  202.       else return "" end;
  203.  
  204.    end;
  205.    
  206. end;
  207. -------------------------------------------------------------------
  208. class LBLD_DIGRAPH{NTP,NLB,ELB} < $LBLD_DIGRAPH{NTP,NLB,ELB} is
  209.    -- A standard labelled digraph, where NTP represents the type 
  210.    -- of the nodes, NLB represents the node labels (which need not
  211.    -- be unique) and ELB represents the type of the edge labels
  212.    -- which also need not be unquie
  213.    include DIGRAPH{NTP} create->private old_create,str->n;
  214.    include LBLD_DIGRAPH_INCL{NTP,NLB,ELB};
  215.    
  216.    create: SAME is res ::= old_create; res.init_labels; return res; end;
  217.    
  218. end;
  219. -------------------------------------------------------------------
  220.